(module level0 mzscheme
  (require "../core.scm")
  
  (define-cat-prim (add_int (-> (int int) int))
    (metadata (desc "Adds two integers together."))
    (x y) => (+ x y))
  (define-cat-prim (compose (-> ((-> 'A 'B) (-> 'B 'C)) (-> 'A 'C)))
    (metadata (desc "Composes two functions."))
    (x y) => (lambda (s) (y (x s))))
  (define-cat-prim (cons (-> ((list 'a) 'a) (list 'a)))    
    (metadata (desc "Adds an item to the beginning of a list."))
    (Y x) => (cons x Y))
  (define-cat-prim (div_int (-> (int int) int)) 
    (metadata (desc "Divides the top value from the second value "
                    "truncating the result."))
    (x y) => (quotient x y))
  (define-cat-prim (dup (-> 'a ('a 'a)))
    (metadata (desc "Duplicates the top item on the stack."))
    () x  => x)
  (define-cat-prim (empty (-> (list 'a) ((list 'a) bool)))   
    (metadata (desc "Returns true if a list contains no items."))
    () x  => (null? x))
  (define-cat-prim (eq (-> ('a 'a) bool))      
    (metadata (desc "Compares two items for equality."))
    (x y) => (equal? x y))
  (define-cat-prim (false (-> () bool))   
    (metadata (desc "Pushes a boolean value representing false onto the stack."))
    ()    => #f)
  (define-cat-prim (if (-> ('A bool (-> 'A 'B) (-> 'A 'B)) 'B))
    (metadata (desc "Conditionally executes one of two functions depending on "
                    "the boolean value below the functions."))
    (lambda (s)
      (list-match s (if-false if-true test) rest
                  ((if test if-true if-false) rest))))
  (define-cat-prim (lt_int (-> (int int) bool))  
    (metadata (desc "Returns true if the top element is less than the "
                    "second element."))
    (x y) => (< x y))
  (define-cat-prim (mod_int (-> (int int) int)) 
    (metadata (desc "Returns the remainder of dividing the top value from the "
                    "second value."))
    (x y) => (modulo x y))
  (define-cat-prim (mul_int (-> (int int) int)) 
    (metadata (desc "Multiplies the top two integers."))
    (x y) => (* x y))
  (define-cat-prim (neg_int (-> int int)) 
    (metadata (desc "Negates the top value."))
    (x)   => (- x))
  (define-cat-prim (nil (-> () (list 'a)))     
    (metadata (desc "Creates an empty list."))
    ()    =>  ())
  (define-cat-prim (pop (-> 'a ()))     
    (metadata (desc "Removes the top item from the stack."))
    (x)   => )
  (define-cat-prim (quote (-> 'a (-> () 'a)))   
    (metadata (desc "Quotes a value creating a nullary constant generating "
                    "function."))
    (x)   => (lambda (s) (cons x s)))
  (define-cat-prim (swap (-> ('a 'b) ('b 'a)))
    (metadata (desc "Swap the top two items on the stack."))
    (x y) => y x)
  (define-cat-prim (true (-> () bool))    
    (metadata (desc "Pushes a boolean value representing true onto the stack."))
    ()    => #t)
  (define-cat-prim (uncons (-> (list 'a) ((list 'a) 'a)))  
    (metadata (desc "Removes the first item from a list."))
    (x)   => (cdr x) (car x))
  
  ;; The implementation of the while-primitive uses the given function, so it
  ;; needs to be exported.
  (provide cat-while)
  (define (cat-while s)
    (list-match s (pred func) rest
    (let loop ((s (pred rest)))
      (if (car s)
          (loop (pred (func (cdr s))))
          (cdr s)))))
  (define-cat-prim (while (-> ('A (-> 'A 'A) (-> 'A ('A bool))) 'A)) 
    (metadata (desc "Repeatedly executes a function while the predicate returns "
                    "true."))
    cat-while))
